home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 March / macformat-022.iso / Shareware City / Graphics / Fractal Lab Kit 3.0 / Demo / Cathedral (b&w) next >
Encoding:
Text File  |  1993-12-02  |  3.0 KB  |  113 lines  |  [TEXT/ALFA]
  1. page  -1 28 +md !
  2.  
  3. ( Cathedral Demo for Fractal Lab Kit 2.0 )
  4. ( RTK, 12-02-93 )
  5.  
  6. ( Warning!  This demo clears the shell code! )
  7.  
  8. ( Press any key to continue... )
  9.  
  10. 0 28 +md !
  11. key drop  forget shellcode
  12.  
  13. ( Fractals used... )
  14.  
  15. : blocks ( -- ) ( load Blocks maps )
  16.     0. .3 .54 0. .69 .44 .21 1 set
  17.     -.65 0. 0. .41 .66 .57 .26 2 set
  18.     .24 0. 0. -.32 .33 .35 .15 3 set
  19.     .38 0. 0. .41 .6 .02 .19 4 set
  20.     -.28 0. 0. -.523 .3 .53 .19 5 set
  21.     5 maps ;
  22.  
  23. : tree ( -- ) ( load Tree maps )
  24.     .03 0. 0. .48 -.005 0. .05 1 set
  25.     .03 0. 0. .48 .01 0. .05 2 set
  26.     .035 0. 0. -.44 .01 .21 .05 3 set
  27.     .035 0. 0. .41 -.007 .02 .05 4 set
  28.     .41 -.41 .41 .41 -.1 .23 .4 5 set
  29.     .41 .41 -.41 .41 .01 .23 .4 6 set
  30.     6 maps ;
  31.  
  32. : sierpinski ( -- ) ( load Sierpinski maps )
  33.     .5 0. 0. .5 0. 0. .3333 1 set
  34.     .5 0. 0. .5 .5 0. .3333 2 set
  35.     .5 0. 0. .5 .25 .5 .3333 3 set
  36.     3 maps ;
  37.  
  38. : koch ( -- ) ( load maps to generate the Koch curve )
  39.     0.333 0.0 0.0 0.333 0.0 0.0 0.25 1 set
  40.     0.167 -0.288 0.288 0.167 0.333 0.0 0.25 2 set
  41.     0.167 0.288 -0.288 0.167 0.5 0.288 0.25 3 set
  42.     .333 0. 0. .333 .667 0. .25 4 set
  43.     4 maps ;
  44.  
  45. : fern ( -- ) ( load Fern maps )
  46.     .81 .07 -0.04 .84 .12 .195 .75 1 set
  47.     .18 -0.25 .27 .23 .12 .02 .115 2 set
  48.     .19 .275 .238 -.14 .16 .12 .115 3 set
  49.     .0235 .087 .045 .1666 .11 0. .02 4 set
  50.     4 maps ;
  51.  
  52. ( Definitons )
  53.  
  54. variable depth
  55.  
  56. : drawit ( -- )  depth @ idraw ;
  57. : 1drawit ( -- ) depth @ 1 + idraw ;
  58. : 2drawit ( -- ) depth @ 2 + idraw ;
  59.  
  60. : getMouseClick ( -- )  begin  ?button until ;
  61.  
  62. : building  
  63. blocks  3.0 range  178 190 screen  2drawit  ( building )
  64. 280 190 screen  2drawit  381 190 screen  2drawit
  65. 1. 2. scale  4.5 range  115 193 screen  2drawit
  66. ;
  67.  
  68. : tower  
  69. sierpinski  118 55 screen  4.9 range  2drawit            ( tower )
  70. ;
  71.  
  72. : forest  
  73. tree  1. 1. scale  2. range  200 330 screen  1drawit      ( forest )
  74. 100 280 screen  1drawit  55 330 screen  1drawit  4. range
  75. 65 100 screen  drawit  50 130 screen  drawit
  76. ;
  77.  
  78. : roof   1. 1. scale 
  79. koch  3. range  180 90 screen  drawit                      ( roof )
  80. 280 90 screen  drawit  382 90 screen  drawit
  81. ;
  82.  
  83. : path  
  84. 285 187 !pen  317 236 -to  318 272 -to  277 341 -to      ( path )
  85. 305 187 !pen  347 236 -to  349 272 -to  317 341 -to
  86. ;
  87.  
  88. : shrubs  
  89. fern  1. 1. scale  10. range  408 261 screen  drawit     ( shrubs )
  90. 415 341 screen  drawit  420 280 screen  drawit
  91. 450 270 screen  drawit  430 310 screen  drawit
  92. 440 300 screen  drawit  415 330 screen  drawit
  93. ;
  94.  
  95. ( Draw the cathedral )
  96.  
  97. : cathedral ( -- ) ( create the whole thing )
  98.  
  99. page ." Cathedral - an example of drawing with fractals" cr cr
  100. ." Enter the drawing depth ( 1=fastest, 10=slowest) ?" input 
  101. dup 11 < if depth ! else drop 1 depth ! then cr cr
  102. ." When I finish drawing I will wait for you to click the mouse button" cr
  103. ." before ending." cr
  104. cr  ." Press any key to draw..." key drop
  105.  
  106. ( draw the parts )  reset  off clear  
  107.  
  108. building  tower  roof  forest  path  shrubs 
  109.  
  110. 0 !FONT  12 !FSIZE  5 15 !pen  ."  Cathedral"  4 !FONT  9 !FSIZE
  111.  
  112. getMouseClick  cr ;  cathedral
  113.